home *** CD-ROM | disk | FTP | other *** search
/ Games of Daze / Infomagic - Games of Daze (Summer 1995) (Disc 1 of 2).iso / x2ftp / msdos / iguana / incosrc / incosrc.exe / UTIL / GFV20.ARJ / GFV.PAS < prev   
Pascal/Delphi Source File  |  1993-12-18  |  10KB  |  408 lines
  1. {$A+,B-,D+,E+,F-,G+,I-,L+,N+,O-,R-,S-,V-,X+}
  2. {$M 16384,0,655360}
  3. (* ------------------------------- GFV.PAS ---------------------------- *)
  4. (* Bye Jare/Iguana. Want more comments? Write'em! :-)                   *)
  5. (* This is quite a big shit! Really! But cracks data like a beast!      *)
  6.  
  7. USES
  8.    Crt, Objects;
  9.  
  10. TYPE
  11.    TVGAScr = ARRAY [0..199,0..319] OF BYTE;
  12. VAR
  13.    VGAScr : TVGAScr ABSOLUTE $A000:0000;
  14.  
  15.  
  16. TYPE
  17.    TPal = ARRAY[1..768] OF BYTE;
  18. VAR
  19.    fpal : FILE OF TPal;
  20.    pal  : TPal;
  21.    thereIsPal : BOOLEAN;
  22.  
  23. PROCEDURE DumpPal(VAR p: TPal); ASSEMBLER;
  24.    ASM
  25.       MOV DX,3C8h
  26.       XOR AX,AX
  27.       OUT DX,AL
  28.       INC DX
  29.       MOV CX,768
  30.       PUSH DS
  31.       LDS SI,p
  32.    @@l:
  33.        OUTSB
  34.        LOOP @@l
  35.       POP DS
  36.    END;
  37.  
  38. PROCEDURE SetVMode;
  39.    BEGIN
  40.       ASM
  41.            MOV     AX,13h
  42.            INT     10h
  43.  
  44.            MOV     DX,3C8h
  45.            XOR     AX,AX
  46.            OUT     DX,AL
  47.            INC     DX
  48.            MOV     CX,64
  49.          @@l1:
  50.            OUT     DX,AL
  51.            OUT     DX,AL
  52.            OUT     DX,AL
  53.            INC     AL
  54.            LOOP    @@l1
  55.  
  56.            XOR     AX,AX
  57.            MOV     CX,64
  58.          @@l2:
  59.            MOV     AL,AH
  60.            OUT     DX,AL
  61.            XOR     AL,AL
  62.            OUT     DX,AL
  63.            OUT     DX,AL
  64.            INC     AH
  65.            LOOP    @@l2
  66.  
  67.            XOR     AX,AX
  68.            MOV     CX,64
  69.          @@l3:
  70.            XOR     AL,AL
  71.            OUT     DX,AL
  72.            MOV     AL,AH
  73.            OUT     DX,AL
  74.            XOR     AL,AL
  75.            OUT     DX,AL
  76.            INC     AH
  77.            LOOP    @@l3
  78.  
  79.            XOR     AX,AX
  80.            MOV     CX,64
  81.          @@l4:
  82.            XOR     AL,AL
  83.            OUT     DX,AL
  84.            OUT     DX,AL
  85.            MOV     AL,AH
  86.            OUT     DX,AL
  87.            INC     AH
  88.            LOOP    @@l4
  89.       END;
  90.       IF thereIsPal THEN
  91.          DumpPal(pal)
  92.    END;
  93.  
  94.  
  95. PROCEDURE Prompt(VAR s: STRING; VAR v : INTEGER);
  96.    LABEL
  97.       SkipKeyb;
  98.    BEGIN
  99.       REPEAT
  100.          ASM
  101.             MOV AX,3
  102.             INT 10h
  103.          END;
  104.          Write(s);
  105.          ASM
  106.           @@c:
  107.             MOV AH,1
  108.             INT 16h
  109.             JZ  @@c
  110.             CMP AL,13
  111.             JNZ @@c1
  112.             XOR AX,AX
  113.             INT 16h
  114.             JMP SkipKeyb
  115.           @@c1:
  116.          END;
  117.          ReadLn(v);
  118. SkipKeyb:
  119.       UNTIL v > 0;
  120.    END;
  121.  
  122. PROCEDURE PromptLong(VAR s: STRING; VAR v : LONGINT);
  123.    LABEL
  124.       SkipKeyb;
  125.    BEGIN
  126.       REPEAT
  127.          ASM
  128.             MOV AX,3
  129.             INT 10h
  130.          END;
  131.          Write(s);
  132.          ASM
  133.           @@c:
  134.             MOV AH,1
  135.             INT 16h
  136.             JZ  @@c
  137.             CMP AL,13
  138.             JNZ @@c1
  139.             XOR AX,AX
  140.             INT 16h
  141.             JMP SkipKeyb
  142.           @@c1:
  143.          END;
  144.          ReadLn(v);
  145. SkipKeyb:
  146.       UNTIL v >= 0;
  147.    END;
  148.  
  149. { -------------------------------------------------- }
  150.  
  151. TYPE
  152.    BUF = ARRAY [1..64000] OF BYTE;
  153. VAR
  154.    bye : BOOLEAN;
  155.    key : CHAR;
  156.    p   : ^BUF;
  157.    scr : BUF ABSOLUTE $a000:0000;
  158.    f   : TDosStream;
  159.    pos, oldp, len : LONGINT;
  160.    olds, step : INTEGER;
  161.    oldh, hsiz : INTEGER;
  162.    i : INTEGER;
  163.    s, pr : STRING;
  164.  
  165.  
  166. PROCEDURE DoSavingProc;
  167.    VAR
  168.       len : LONGINT;
  169.       fn  : STRING;
  170.       fd  : TDosStream;
  171.    BEGIN
  172.       f.Reset;
  173.       f.Seek(pos);
  174.       len := 0;
  175.       pr := 'Enter number of bytes to save into GFVDUMP.BIN: ';
  176.       PromptLong(pr, len);
  177.       IF len > 0 THEN BEGIN
  178.          fd.Init('GFVDUMP.BIN', stCreate);
  179.          REPEAT
  180.             IF len > 64000 THEN BEGIN
  181.                FillChar(p^, 64000, #0);
  182.                f.Read(p^, 64000);
  183.                fd.Write(p^, 64000);
  184.                len := len - 64000
  185.             END ELSE BEGIN
  186.                f.Read(p^, len);
  187.                fd.Write(p^, len);
  188.                len := 0
  189.             END
  190.          UNTIL len = 0;
  191.          fd.Done
  192.       END;
  193.       oldh := 0;                { Force redraw. }
  194.       SetVMode
  195.    END;
  196.  
  197.  
  198. PROCEDURE ShowPage;
  199.    VAR
  200.       off : WORD;
  201.       shs : WORD;
  202.       i, j : INTEGER;
  203.       post : LONGINT;
  204.    BEGIN
  205.       f.Reset;
  206.       f.Seek(pos);
  207.       post := pos;
  208.       off := 32768+1;
  209.       IF hsiz > 320 THEN
  210.          shs := 320
  211.       ELSE
  212.          shs := hsiz;
  213.       FOR i := 0 TO 199 DO BEGIN
  214.          IF KeyPressed THEN
  215.             EXIT;
  216.          FOR j := 0 TO shs-1 DO BEGIN
  217.             IF off > 32768 THEN BEGIN
  218.                FillChar(p^, 32768, #0);
  219.                IF (len - post) >= 32768 THEN BEGIN
  220.                   f.Read(p^, 32768);
  221.                   post := post + 32768
  222.                END ELSE BEGIN
  223.                   f.Read(p^, len - post);
  224.                   post := len
  225.                END;
  226.                off := off - 32768
  227.             END;
  228.             VGAScr[i,j] := p^[off];
  229.             off := off + step;
  230.          END;
  231.          IF shs < 320 THEN
  232.             FOR j := shs TO 319 DO
  233.                VGAScr[i,j] := 0;
  234.          IF hsiz > 320 THEN
  235.             off := off + step*(hsiz-320)
  236.       END
  237.    END;
  238.  
  239.  
  240. PROCEDURE Usage;
  241.    BEGIN
  242.       WriteLn(#13#10,
  243.               'Graphical File Viewer v2.01 bye Jare/Iguana'#13#10,
  244.               'Views a file in mode 13h. Useful for finding graphic data, etc.'#13#10,
  245.               #13#10,
  246.               '   Usage: GFV <file.ext> [palette file]'#13#10,
  247.               '          If not given, palette is set to 64 shades of Gray,'#13#10,
  248.               '             then Red, Green and Blue.'#13#10,
  249.               #13#10,
  250.               '   Browse with movement keys.'#13#10,
  251.               '   ''<'', ''>'' & ''5'' - set horizontal shift.'#13#10,
  252.               '   ''-'' & ''+''      - change byte step in file (for word data etc).'#13#10,
  253.               '   ''O''            - get/set new file offset.'#13#10,
  254.               '   ''S''            - save a portion of the file to GFVDUMP.BIN.'#13#10,
  255.               '   Space          - Redraw the screen.')
  256.    END;
  257.  
  258. BEGIN
  259.    IF ParamCount < 1 THEN BEGIN
  260.       Usage;
  261.       HALT(1)
  262.    END;
  263.    s := ParamStr(1);
  264.    IF (s[1] IN ['-','/', '?']) OR
  265.       (s[2] IN ['-','/', '?']) THEN BEGIN
  266.        Usage;
  267.        HALT(1)
  268.    END;
  269.    f.Init(s, stOpenRead);
  270.    IF f.Status <> stOk THEN BEGIN
  271.       Usage;
  272.       WriteLn(#13#10'ORROR: file ', s, ' not found!');
  273.       HALT(1)
  274.    END;
  275.  
  276.    NEW(p);
  277.    oldp := 0;
  278.    pos  := 0;
  279.    len  := f.GetSize;
  280.    olds := 0;
  281.    step := 1;
  282.    oldh := 0;
  283.    hsiz := 320;
  284.  
  285.    thereIsPal := FALSE;
  286.    IF ParamCount > 1 THEN BEGIN
  287.       Assign(fpal, ParamStr(2));
  288.       Reset(fpal);
  289.       IF IOResult = 0 THEN BEGIN
  290.          Read(fpal, pal);
  291.          IF IOResult = 0 THEN
  292.             thereIsPal := TRUE;
  293.          Close(fpal)
  294.       END
  295.    END;
  296.  
  297.    SetVMode;
  298.  
  299.    bye := FALSE;
  300.    REPEAT
  301.       IF (hsiz <> oldh) OR (pos <> oldp) OR (step <> olds) THEN BEGIN
  302.          ShowPage;
  303.          oldp := pos;
  304.          oldh := hsiz;
  305.          olds := step
  306.       END;
  307.       key := ReadKey;
  308.       IF key = #0 THEN BEGIN
  309.          key := ReadKey;
  310.          CASE key OF
  311.              #80 : key := '2';
  312.              #75 : key := '4';
  313.              #77 : key := '6';
  314.              #72 : key := '8';
  315.              #79 : key := '1';
  316.              #71 : key := '7';
  317.              #82 : key := '0';
  318.              #83 : key := '.';
  319.              #81 : key := '3';
  320.              #73 : key := '9'
  321.              ELSE
  322.                 key := #0
  323.          END
  324.       END;
  325.       CASE UpCase(key) OF
  326.          '9': BEGIN
  327.                  DEC(pos,LONGINT(step)*200*hsiz);
  328.                  IF pos < 0 THEN
  329.                     pos := 0
  330.               END;
  331.          '3': IF pos < len THEN INC(pos,LONGINT(step)*200*hsiz);
  332.          '7': pos := 0;
  333.          '1': BEGIN
  334.                  pos := len - LONGINT(step)*200*hsiz;
  335.                  IF pos < 0 THEN
  336.                     pos := 0
  337.               END;
  338.          '4': BEGIN
  339.                  DEC(pos,step);
  340.                  IF pos < 0 THEN
  341.                     pos := 0
  342.               END;
  343.          '6': IF pos < len THEN INC(pos, step);
  344.          '8': BEGIN
  345.                  DEC(pos,LONGINT(hsiz)*step);
  346.                  IF pos < 0 THEN
  347.                     pos := 0
  348.               END;
  349.          '2': IF pos < len THEN INC(pos, LONGINT(hsiz)*step);
  350.  
  351.          '0', '<': IF hsiz > 1 THEN
  352.                   DEC(hsiz);
  353.          '.', '>': IF pos < len THEN INC(hsiz);
  354.  
  355.          '-': IF step > 1 THEN DEC(step);
  356.          '+': INC(step);
  357.          '5': BEGIN
  358.                  Str(hsiz, pr);
  359.                  pr := 'Enter desired horizontal shift (normal = 320, current = '
  360.                        + pr + '): ';
  361.                  Prompt(pr, hsiz);
  362.                  oldh := 0;     { Force redraw. }
  363.                  SetVMode
  364.               END;
  365.  
  366.          #27: bye := TRUE;
  367.  
  368.          'O': BEGIN
  369.                  Str(pos, pr);
  370.                  pr := 'Enter new file position, current = '
  371.                        + pr + '): ';
  372.                  PromptLong(pr, pos);
  373.                  oldh := 0;     { Force redraw. }
  374.                  SetVMode
  375.               END;
  376.  
  377.          'S': DoSavingProc;
  378.  
  379.          ' ': oldh := 0         { Force redraw. }
  380.  
  381.          ELSE BEGIN
  382.             sound(1000);
  383.             ASM
  384.                MOV  CX,10000
  385.               @@w:
  386.                LOOP @@w
  387.             END;
  388.             nosound
  389.          END
  390.       END
  391.    UNTIL bye;
  392.  
  393.    f.Done;
  394.    ASM
  395.         MOV     AX,3
  396.         INT     10h
  397.    END;
  398.    WriteLn('Your situation at exit was the following:');
  399.    WriteLn('    File:      ', ParamStr(1));
  400.    WriteLn('    Position:  ', pos);
  401.    WriteLn('    Width:     ', hsiz);
  402.    WriteLn('    Byte step: ', step);
  403.    WriteLn;
  404.    WriteLn('Did you see something interesting?')
  405. END.
  406.  
  407. (* -------------------------- End of GFV.PAS -------------------------- *)
  408.